c###ionplt.for
      SUBROUTINE IONPLT(K)
C--------------------------------
C
C     THIS ROUTINE OUTPUTS IONOGRAMS
C
C     K IS SAMPLE AREA INDEX
C
      COMMON / FILES / LUI, LUO, LU2, LU5, LU6, LU15, LU16, LU20, LU25,
     A LU26, LU35
      COMMON / TIME / IT, GMT, UTIME(24), GMTR, XLMT(24), ITIM, JTX
      COMMON / MFAC /F2M3(5),HPF2(5),ZENANG(5),ZENMAX(5),IEDP,FSECV(3)
      COMMON/GEOG/GYZ(5),RAT(5),GMDIP(5),CLCK(5),ABIY(5),ARTIC(5),SIGPAT
     A (5),EPSPAT(5)
      COMMON /ES /FS (3, 5), HS (5)
      COMMON /CON /D2R, DCL, GAMA, PI, PI2, PIO2, R2D, RZ, VOFL
      COMMON / ION / IHRE, IHRO, IHRS, LUFP, METHOD, NOISE, NPSL
      COMMON /RON /CLAT(5), CLONG(5), GLAT(5), RD(5), FI(3,5), YI(3,5),
     1HI(3,5), HPRIM(30,5), HTRUE(30,5), FVERT(30,5),KM,KFX, AFAC(30,5),
     2HTR(50,3), FNSQ(50,3)
      DIMENSION JFSCAL(10)
      CHARACTER ILY(4)*3, IMINUS*1, IPLUS*1, IBLANK*3, IDOT*3,
     A IXXX*3, IBB(6)*3, IS(3)*3, INTG(2)*10, IFONE(3)*10,
     B IX(100)*3, IC*1, IB*3,ITF*1
      DATA ILY/' E=','F1=','F2=','ES='/
      DATA IMINUS/'-'/, IPLUS/'+'/, IBLANK/'   '/, IDOT/'.  '/,
     A     IXXX/'X  '/
      DATA IBB/'600', '500', '400', '300', '200', '100'/
      DATA IS /'U', 'M', 'L'/
      DATA INTG/'GAUSSIAN  ','MODEL SEG '/
      DATA IFONE/'GONE      ','PARABOLIC','LINEAR   '/
      ITF=CHAR(12)
      IF(METHOD - 2) 100, 105, 100
  100 JOUT = 61
      WRITE(JOUT,'(A1)')ITF
      GO TO 107
  105 JOUT = LUO
C.....CALL SUBROUTINE OUTTOP TO OUTPUT HEADER LINES
      CALL OUTTOP
  107 IF(FI(3,K) - 10.) 110, 110, 130
  110 FINC = .1
      DO 115 IJ = 1, 10
  115 JFSCAL (IJ) = IJ
      GO TO 140
  130 FINC = .2
      DO 135 IJ = 1, 10
  135 JFSCAL (IJ) = IJ + IJ
  140 CONTINUE
      CLA = CLAT (K) * R2D
      CLON = CLONG (K) * R2D
      IDX = 2 * K - 1
      IF(KFX - 3) 141, 142, 142
  141 IDY = KFX
      GO TO 143
  142 IDY = K + 1
  143 RDX = RD(IDX) * RZ
      RDY = RD(IDY) * RZ
      CKC=CLCK(K)
      INDEX = 1
      IF( FI(2,K) ) 305,305,310
  305 INE = 1
      IF(IEDP) 325, 306, 306
  306 INDEX = 2
      GO TO 325
  310 IF(FSECV(K)) 315, 315, 320
  315 INE = 2
      GO TO 325
  320 INE = 3
  325 CONTINUE
      WRITE(JOUT,524) GMT,CKC,CLA,CLON,RDX,RDY,INTG(INDEX),IFONE(INE)
      WRITE(JOUT,522)
      WRITE(JOUT,501) JFSCAL
      WRITE(JOUT, 502)
      IBI = 1
      ZOB2 = 605.
      IHLS = (ZOB2 - HS(K)) * .1 + 1.0
      IPX = 1
      DO 255 IDN = 1, 51
      DO 145 ICR = 1, 100
  145 IX (ICR) = IBLANK
      ZOB1 = ZOB2
      ZOB2 = ZOB1 - 10.
      IF (IDN - IPX)150, 155, 155
  150 IC = IMINUS
      IB = IBLANK
      GO TO 160
  155 IC = IPLUS
      IB = IBB (IBI)
      IBI = IBI + 1
      IPX = IPX + 10
  160 CONTINUE
C
C     TEST FOR ES LEVEL
C
      IF(IDN - IHLS) 180, 165, 180
  165 ISX = 0
      DO 175 IZ = 1, 3
      ISB = ISX + 1
      ISX = FS (IZ, K) / FINC + 0.5
      ISX = MIN0 (100, ISX)
      IF (ISX .LT. ISB) GO TO 265
      DO 170 JJ = ISB, ISX
  170 IX (JJ) = IS (IZ)
  265 CONTINUE
  175 CONTINUE
      GO TO 225
  180 CONTINUE
      DO 215 IH = 1, 30
      ICR = FVERT(IH,K) / FINC + 1.0
      ICR=MIN0 (100,ICR)
      ICR=MAX0(1,ICR)
      IF (HPRIM (IH, K) - ZOB1)185, 185, 195
  185 IF (HPRIM (IH, K) - ZOB2)195, 195, 190
  190 IX(ICR) = IXXX
  195 IF (HTRUE (IH, K) - ZOB1)200, 200, 215
  200 IF (HTRUE (IH, K) - ZOB2)215, 215, 205
  205 IX(ICR) = IDOT
  215 CONTINUE
  225 CONTINUE
      IF (IDN - 3)235, 235, 245
  235 WRITE(JOUT, 506) IB, IC, ILY(IDN), FI(IDN,K), YI(IDN,K),
     1 HI(IDN,K), (IX(IPRT),IPRT=23,100), IC, IDN, FVERT(IDN,K),
     2 HTRUE(IDN,K), HPRIM(IDN,K)
      GO TO 255
  245 IF(IDN - 4) 247, 246, 247
  246 WRITE(JOUT,528) IB,IC,ILY(IDN),FS(1,K),FS(2,K),FS(3,K),HS(K),
     A (IX(IPRT),IPRT=29,100),IC,IDN,FVERT(IDN,K),HTRUE(IDN,K),
     B HPRIM(IDN,K)
      GO TO 255
  247 IF(IDN - 30) 250, 250, 252
  250 WRITE(JOUT, 505) IB, IC, IX, IC, IDN, FVERT(IDN,K), HTRUE(IDN,K),
     1 HPRIM(IDN,K)
      GO TO 255
  252 WRITE(JOUT, 504) IB, IC, IX, IC
  255 CONTINUE
      WRITE(JOUT, 502)
      WRITE(JOUT, 500) JFSCAL
      RETURN
  500 FORMAT(' ',13X,10(I2,8X))
  501 FORMAT(' ',13X,9(I2,8X),I2,6X,'FVERT',2X,'HTRUE',2X,'HPRIM')
  502 FORMAT(' ',4X,20('+----'))
  504 FORMAT(' ',1X,A3,A1,100A1,A1)
  505 FORMAT(' ',1X,A3,A1,100A1,A1,I3,3F7.2)
  506 FORMAT(' ',1X,A3,A1,1X,A3,F5.2,2(1X,F5.1),1X,78A1,A1,I3,3F7.2)
  522 FORMAT(' ',20X,'VIRTUAL HEIGHT - REFLECTION HEIGHT VS. SOUNDING',
     A ' FREQUENCY -MHZ-')
  524 FORMAT(' ',2X,'GMT = ',F5.1,3X,'LMT = ',F5.1,3X,'LAT = ',F6.2,
     A ' N',2X,F7.2,' W  DIST = ',2(F5.0,1X),' KM',2X,A10,
     B ' HP   F1 IS ',A10,/)
  528 FORMAT(' ',1X,A3,A1,1X,A3,3(F5.2,1X),F5.1,1X,72A1,
     A A1,I3,3F7.2)
      END
C--------------------------------
